home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / doom / quake.zip / XPAK040.ZIP / XPAK.PAS < prev    next >
Pascal/Delphi Source File  |  1996-07-02  |  35KB  |  1,041 lines
  1. program xPak; (* .PAK file manipulator *)
  2.  
  3. {$M 16384,102400,655360}   {Enough heap to load PAK0.PAK directory min}
  4.  
  5. uses wildmat,dos,crt;
  6.  
  7. const
  8.      LUMP_NAME_SIZE      = $40-8;
  9.      END_CHARS           = [#10,#0];
  10.      PAK_HEADER          = 'PACK';
  11.      PAK_PROTECTED       = 'PAK0.PAK';
  12.      MAX_BLOCK_SIZE:word = 65528;
  13.  
  14.      {HALT codes, not fully implemented yet}
  15.      HALT_PARSE          = 1;
  16.      HALT_SAFETY         = 3;
  17.      HALT_QUIT           = 4;
  18.  
  19. type
  20.     Buffer= array[1..65528] of byte;
  21.     LumpNameType= array[1..LUMP_NAME_SIZE] of char;
  22.     Modes=(None,List,Extract,Add,Remove,Rename,Merge);
  23.  
  24.     DirEntry=record
  25.       Lumpname : LumpNameType;
  26.       Pos      : Longint;
  27.       Size     : LongInt;
  28.     end;
  29.  
  30.     PFileSpecList=^TFileSpecList;
  31.     TFileSpecList=record
  32.       FileSpec : string[140];
  33.       LumpName : string[LUMP_NAME_SIZE];
  34.       Remapped : boolean;
  35.       included : boolean;
  36.       Next     : PFileSpecList;
  37.     end;
  38.  
  39.     PMasterDir=^TMasterDir;
  40.     TMasterDir=record         {212 bytes}
  41.       Dir      : DirEntry;
  42.       Filename : string[140];
  43.       Prev     : PMasterDir;
  44.       Next     : PMasterDir;
  45.     end;
  46.  
  47.     TFlags=record
  48.       Override : boolean;
  49.       Verbose  : boolean;
  50.       Force    : boolean;
  51.       Interact : boolean;
  52.       Query    : boolean;
  53.       AccessPAK: boolean;
  54.       Backup   : boolean;
  55.       JustName : boolean;
  56.       Debug    : boolean;
  57.     end;
  58.  
  59.  
  60. var
  61.    Flags: TFlags;
  62. {   o: text;}
  63.  
  64.  
  65. procedure Help;
  66.   begin
  67.        Writeln('usage: xpak <pakfile> -l|-e|-a|-r|-n [lumpname:]filespec [switches]');
  68.        Writeln;
  69.        Writeln('Command line must contain *one* of the following switches:');
  70.        writeln('           (r) = read; (c) = create; (m) = modify');
  71.        writeln('    -l (r) List contents of PAK file');
  72.        writeln('    -e (r) Extract specified files to directory tree');
  73.        writeln('    -a (c) Add specified files to PAK file (also create and update files)');
  74.        writeln('    -r (m) Remove specified lumps');
  75.        writeln('    -n (m) Rename lump in PAK file (renames to :filename');
  76.        writeln('Notice: -u and old -c have been removed.  They have been integrated into -a');
  77.        writeln(#13#10,'Press any key for next page');ReadKey;
  78.        writeln(#13#10,'Modification switches:');
  79.        writeln('    -o     Overrides some of the safety features in xpak.  These include');
  80.        writeln('           not writing to ID1.PAK and requiring existance of ./quake.exe');
  81.        writeln('    -j     (with -l) display just names only (useful to create @file lists)');
  82.        writeln('    -v     verbose mode.  Display names of lumps during processing.');
  83.        writeln('    -d     debug mode.  Displays all sorts of useless debugging info.');
  84.        writeln('    -i     (with -e) Interactive mode.  Prompt to overwrite files');
  85.        writeln('    -f     (with -e) Force overwrites.  Default is to skip existing files');
  86.        writeln(' #  -q     Query mode, ask before adding/extracting/removing each file');
  87.        writeln(' #  -b     backup PAK file before modification / existing extract targets');
  88.        writeln;
  89.        writeln('Lump names may be specified as free * and ? wildcards, but filenames');
  90.        writeln('(excludes -e) require DOS style paths and wildcards.  To access a lump name');
  91.        writeln('with a different filename, use the syntax lumpname:filename.  Wildcards not');
  92.        writeln('allowed.  File lists can be referenced as @filename. # denotes comment line');
  93.        writeln;
  94.        writeln('Remember that this is an early version, and may have ''problems'' =) Note also');
  95.        writeln('that xpak is now more-or-less unsupported, as I am working on a rewrite, sixpak');
  96.        halt;
  97.   end;
  98.  
  99.  
  100. procedure Lower4(var Str: String);
  101.   InLine(          {Adapted From SWAG}
  102.     $8C/$DA/$5E/$1F/$FC/$AC/$30/$E4/$89/$C1/$E3/$12/$BB/Ord('A')/Ord('Z')/
  103.     $AC/$38/$D8/$72/$08/$38/$F8/$77/$04/$80/$44/$FF/$20/$E2/$F1/$8E/$DA);
  104.  
  105.  
  106. procedure cvBackSlash(var ForeStr: string);
  107.   var i: byte;
  108.   begin
  109.        for i:=1 to Length(ForeStr) do
  110.            if ForeStr[i]='/' then ForeStr[i]:='\';
  111.   end;
  112.  
  113.  
  114. procedure cvForeSlash(var BackStr: string);
  115.   var i: byte;
  116.   begin
  117.        for i:=1 to Length(BackStr) do
  118.            if BackStr[i]='\' then BackStr[i]:='/';
  119.   end;
  120.  
  121.  
  122. procedure SetStr(var st:string; const ar:LumpNameType);
  123.   var
  124.      i: byte;
  125.   begin
  126.        st:='';
  127.        for i:=1 to LUMP_NAME_SIZE do
  128.            begin
  129.            if ar[i] in END_CHARS then begin dec(i); break end;
  130.            st[i]:=ar[i];
  131.            end;
  132.        st[0]:=Char(i);
  133.   end;
  134.  
  135.  
  136. procedure SetArr(var ar: LumpNameType; const st:string);
  137.   var
  138.      i,j: byte;
  139.   begin
  140.        FillChar(ar,SizeOf(ar),0);
  141.        j:=Length(st);
  142.        if Length(st)>LUMP_NAME_SIZE then j:=LUMP_NAME_SIZE;
  143.        for i:=1 to j do
  144.            ar[i]:=st[i];
  145.   end;
  146.  
  147.  
  148. function Exist(const filename:string): boolean;
  149.   var
  150.      DirInfo:SearchRec;
  151.   begin
  152.        FindFirst(filename,Anyfile,DirInfo);
  153.         Exist:=(DosError=0);
  154.   end;
  155.  
  156.  
  157. function MakePAKFilename(const oldname:string):string;
  158.   begin
  159.        if Pos('.',oldname)>0 then
  160.           MakePAKFilename:=oldname
  161.        else
  162.            MakePAKFilename:=oldname+'.pak';
  163.   end;
  164.  
  165.  
  166. procedure AddFileSpec(fs:string; yn: boolean; var TempPos: PFileSpecList);
  167.   var
  168.      spec,lump:string;
  169.      cpos: byte;
  170.      remap:boolean;
  171.   begin
  172.        lump:=fs;spec:=fs;
  173.        cpos:=pos(':',fs);
  174.        remap:=false;
  175.        if cpos>0 then
  176.           begin
  177.           if pos('*',fs)>0 then
  178.              begin writeln('addspec: no wildcards allowed with alternate filenames (yet)'); exit end;
  179.           if pos('?',fs)>0 then
  180.              begin writeln('addspec: no wildcards allowed with alternate filenames (yet)'); exit end;
  181.           lump:=Copy(fs,1,cpos-1);
  182.           spec:=Copy(fs,cpos+1,255);
  183.           remap:=true;
  184.           end;
  185.        New(TempPos^.Next);
  186.        TempPos:=TempPos^.Next;
  187.        cvBackslash(spec);
  188.        cvForeslash(lump);
  189.        Lower4(lump);
  190.        TempPos^.Filespec:=spec;
  191.        TempPos^.Lumpname:=lump;
  192.        TempPos^.Included:=yn;
  193.        TempPos^.Remapped:=remap;
  194.        TempPos^.Next:=nil;
  195.   end;
  196.  
  197.  
  198. procedure FromFile(fn:string;Incl: boolean; var ListTemp: PFileSpecList);
  199.   var
  200.      ff: text;
  201.      fs: string;
  202.   begin
  203.        if fn[1]='@' then Delete(fn,1,1);
  204.        Assign(ff,fn);
  205.        {$I-}
  206.        Reset(ff);
  207.        if IOResult<>0 then
  208.           begin writeln('parse: unable to open filespec list file.'); exit end;
  209.        {$I+}
  210.        while not eof(ff) do
  211.              begin
  212.              ReadLn(ff,fs);
  213.              if fs<>'' then
  214.                 if fs[1]<>'#' then
  215.                    if fs[1]='!' then
  216.                       AddFileSpec(Copy(fs,2,Length(fs)-1),not incl,ListTemp)
  217.                    else
  218.                        AddFileSpec(fs,incl,ListTemp);
  219.              end;
  220.   end;
  221.  
  222.  
  223. function CheckParams(var MainPAK:string; var Files: PFileSpecList):Modes;
  224.   var
  225.      Param:string;
  226.      i:byte;
  227.      TempSpec:PFileSpecList;
  228.      SpecStart: PFileSpecList;
  229.      TempMode: Modes;
  230.      Include: boolean;
  231.   begin
  232.        TempMode:=None;Include:=True;MainPAK:='';
  233.        FillChar(Flags,SizeOf(Flags),0);
  234.        New(Files); TempSpec:=Files;
  235.        TempSpec^.Filespec:='*';
  236.        TempSpec^.Included:=True;
  237.        TempSpec^.Next:=nil;
  238.        if ParamCount=0 then begin writeln('Type `xpak -?` for help.');halt end;
  239.        for i:=1 to ParamCount do
  240.            begin
  241.            Param:=ParamStr(i);
  242.            If Param[1]='-' then
  243.               if Length(Param)=1 then begin Writeln('parse: bad parameter ',Param);halt(1) end
  244.               else
  245.                   Case UpCase(Param[2]) of
  246.                        '?': Help;
  247.                        'B': Flags.Backup:=True;
  248.                        'D': Flags.Debug:=True;
  249.                        'F': Flags.Force:=True;
  250.                        'I': Flags.Interact:=True;
  251.                        'J': Flags.JustName:=True;
  252.                        'O': Flags.Override:=True;
  253.